home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / DDOPEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-06  |  7.5 KB  |  246 lines
  1. unit DDOpen;
  2.  
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  6.   Forms, Dialogs, DB, DBTables, inifiles, grids;
  7. const
  8.     FieldTypeStr : array[ftunknown..ftgraphic] of string[8] =
  9.       ('Unknown', 'String', 'Smallint', 'Integer', 'Word',
  10.        'Boolean', 'Float', 'Currency', 'BCD', 'Date', 'Time',
  11.        'DateTime', 'Bytes', 'VarBytes', 'Blob', 'Memo', 'Graphic');
  12.     FieldTypeLtr : array[ftunknown..ftgraphic] of string[1] =
  13.       ('U', 'S', 'I', 'N', 'W',
  14.        'L', 'F', 'C', 'B', 'D', 'T',
  15.        'A', 'Y', 'V', 'O', 'M', 'G');
  16.  
  17. type
  18.   DDValidationtype = (IsValidDD, DoesNotExist, ExistbutnotDD, NewDD, EmptyString );
  19.  
  20.   TDDCtrl = class(TComponent)
  21.     DictDB: TDatabase;
  22.     DictTable: TTable;
  23.     DictQuery: TQuery;
  24.     DictSource: TDataSource;
  25.   private
  26.     FiniFile : TiniFile;
  27.     FCtrlDictName : Tfilename; {fully qualified name}
  28.     FDictStatus : DDValidationType;
  29.     FDBSGGood : boolean;
  30.     FTableList : tStrings;
  31.     FDBSG : Tstringgrid;  {non-documentation part of dictionary}
  32.     FUpdated : Tdatetime; {info on current dictionary}
  33.     FDictsize : longint;
  34.     FnumRecords,
  35.     Fnumtables,
  36.     FnumFields : integer;
  37.     procedure ReadIniFile;
  38.     function getDictPath : tfilename;
  39.     procedure setDictPath( tmpstr : tfilename);
  40.     function getDictTable : tfilename;
  41.     procedure setDictTable (tmpstr : tfilename);
  42.   protected
  43.     Constructor create(Aowner : Tcomponent); override;
  44.     function OpenDD(const pathname, tablename : string): boolean;
  45.     function CheckOutDD(const Fulltablename : string): DDValidationtype;
  46.  
  47.     { Protected declarations }
  48.   public
  49.  
  50.     { Public declarations }
  51.   published
  52.     property DictStatus: DDValidationType read FDictStatus;
  53.     property FullDDName : tFilename read FCtrlDictName write FCtrlDictName;
  54.     property DictPathName: Tfilename read getDictPath;
  55.     property DictTableName: Tfilename read getDictTable;
  56.     property LastUpdate: tDateTime read Fupdated;
  57.     property DictSize: longint read FDictSize;
  58.     property NumRecords: integer read FNumRecords;
  59.     property numtables: integer read fNumtables;
  60.     property numfields: integer read fNumFields;
  61.     property DBSGExists : boolean read FDBSGGood;
  62.   end;
  63.  
  64.  
  65. procedure Register;
  66.  
  67. implementation
  68.  
  69. {$R *.DFM}
  70. uses utils;
  71. const
  72.    {indexes into DBSG columns}
  73.       tablename = 0;  {string 20}
  74.       tabletype = 1;  {string 20}
  75.       fieldname = 2;  {string[20];}
  76.       tag       = 3;  {string 20  tfield.tag}
  77.       scrprompt = 4;  {string[40]; {tfield.DisplayName}
  78.       scrformat = 5;  {string[80]; {tfield.DisplayText -- an editmask}
  79.       grdprompt = 6;  {string[10];}
  80.       grdwidth  = 7;  {smallint    {tfield.DisplayWidth}
  81.       fldtype   = 8;  {string[1];  {FieldTypeLtr}
  82.       fldlen    = 9;  {smallint    {tfield.size}
  83.       flddec    = 10; {smallint}
  84.       fldidx    = 11; {boolean;}
  85.       idxexp    = 12; {string;}
  86.       tab_order = 13; {integer;}
  87.       isrequired  = 14; {boolean;    {tfield.required}
  88.       defaultis   = 15; {string[80];}
  89.       editmaskis  = 16; {string[80]; {tfield.editMask}
  90.       minval    = 17; {ftfloat  tfield.minvalue}
  91.       maxval    = 18; {ftfloat  tfield.maxvalue}
  92.       vallist   = 19; {ftmemo   list of valid strings}
  93.       { define      documentation only
  94.         validvalue  documentation only
  95.         notes       documentation only}
  96.       hintTxt   = 20;  {string 120}
  97.       helpid    = 21;  {longint;}
  98.       {help, memo only used if helpid not null or 0}
  99.       haslink   = 22;  {boolean;}
  100.       srclinktbl = 23; {string[20];}
  101.       srclinkfld = 24; {string[20];}
  102.       iscalc     = 25; {boolean;}
  103.       formula    = 26; {memo only used if iscalc true}
  104.  
  105. Procedure TDDCtrl.ReadIniFile;
  106. begin
  107.   FIniFile := TiniFile.Create(appname+'.ini');
  108.   FCtrlDictName := FiniFile.ReadString('CtrlDict', 'current', appname+'.dbf');
  109.   FiniFile.free;
  110. end;
  111.  
  112. function TDDCtrl.getDictPath : tfilename;
  113. begin
  114.   result := extractFilePath(FCtrlDictName);
  115. end;
  116. procedure TDDCtrl.setDictPath( tmpstr : tfilename);
  117. begin
  118.   FCtrlDictName := tmpstr;
  119. end;
  120. function TDDCtrl.getDictTable : tfilename;
  121. begin
  122.   result := extractFileName(FCtrlDictName);
  123. end;
  124. procedure TDDCtrl.setDictTable (tmpstr : tfilename);
  125. begin
  126. end;
  127.  
  128. constructor TDDCtrl.create(Aowner : Tcomponent);
  129. begin
  130.   inherited create(Aowner);
  131.   readIniFile;
  132.   DictDB.Databasename := 'DataDictCtrlFormDB';
  133.   if CheckOutDD(FCtrlDictName) = IsValidDD
  134.     then begin
  135.       {first check it out}
  136.       {pull data into stringgrid?
  137.        or set up a permanent link/ query table
  138.        with data to modify current app
  139.        }
  140.       end
  141.     else begin
  142.       {some kind of message about no dictionary
  143.        present?
  144.        }
  145.       end;
  146. end;
  147.  
  148.  
  149. function TDDCtrl.openDD(const pathname, tablename : string): boolean;
  150. begin
  151.   try
  152.     DictDB.close;
  153.     DictDB.Params.clear;
  154.     DictDB.Params.Add('PATH='+PathName);
  155.     DictDB.open;
  156.     DictTable.DatabaseName:= DictDB.databasename;
  157.     DictTable.tablename := TableName;
  158.     DictTable.Active:= True;
  159.     DictSource.DataSet:= DictTable;
  160.     DictQuery.databaseName := DictDB.databasename;
  161.     DictQuery.dataSource := DictSource;
  162.     DictQuery.close;
  163.     DictQuery.sql.clear;
  164.     DictQuery.params.clear;
  165.     result := true;
  166.   except
  167.      on EdataBaseError do begin
  168.        screen.cursor := crDefault;
  169.        MessageDlg('Could not open '+pathname + ' '+tablename, mtInformation, [mbOK], 0);
  170.        result := false;
  171.        end;
  172.      end; {of exceptions}
  173. end;
  174.  
  175. function TDDCtrl.CheckOutDD(const Fulltablename : string): DDValidationtype;
  176. var
  177.     tablefound : boolean;
  178.     sqlstr,
  179.     thistable : string;
  180.     tablenum : integer;
  181.     FileInfo : TsearchRec;
  182.     tableField : tField;
  183.  
  184. begin
  185.   result := isValidDD;
  186.   fnumtables := 0;  fnumFields := 0; fDictsize := 0; fNumRecords := 0;
  187.   FTableList := tstringlist.create;
  188.   if fileExists(fulltablename)
  189.     then begin
  190.       FindFirst(fulltablename, faAnyfile, fileinfo);
  191.       FUpdated := fileDateToDateTime(Fileinfo.time);
  192.       fDictSize := FileInfo.size;
  193.       {not total size, should also get size of .dbt }
  194.       end
  195.     else begin
  196.       result := DoesNotExist;
  197.       exit;
  198.       end;
  199.   if openDD(DictPathName, DictTableName)
  200.     then begin
  201.       fnumrecords := DictTable.RecordCount;
  202.       sqlstr := 'SELECT * FROM '+DictTableName;
  203.       Dictquery.sql.add(sqlstr);
  204.       Dictquery.prepare;
  205.       Dictquery.open;
  206.       Dictquery.first;
  207.       { get tablenames in data dictionary, stick in M_tableList lines}
  208.       if DictQuery.findfield('TABLE_NAME') = nil
  209.         then begin
  210.            result := ExistButNotDD;
  211.            exit;
  212.            end;
  213.       ftableList.add(DictQuery.findfield('TABLE_NAME').text);  {get first one}
  214.       inc(fnumfields);
  215.       DictQuery.next;
  216.       while not DictQuery.eof do begin
  217.         tablefound := false;
  218.         thistable := DictQuery.findfield('TABLE_NAME').text;
  219.         inc(fnumFields);
  220.         for tablenum := 0 to ftablelist.count - 1 do
  221.           if ftableList.strings[tablenum] = thistable
  222.              then begin
  223.                 tablefound := true;
  224.                 break;
  225.                 end;
  226.           {done looking for thistable}
  227.         if not tablefound
  228.           then  ftablelist.add(thistable);
  229.         DictQuery.next;
  230.         end; {while searching for table names}
  231.     DictQuery.close;
  232.     end
  233.   else begin
  234.     result := ExistbutnotDD;
  235.     end;
  236. end;
  237.  
  238.  
  239. procedure Register;
  240. begin
  241.   RegisterComponents('Synature', [TDDCtrl]);
  242. end;
  243.  
  244. end.
  245.  
  246.